perm filename EADD5.2[EAL,HE] blob
sn#712022 filedate 1983-05-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {$NOMAIN Editor: aux routines for addStmnt }
C00005 00003 procedure addEndStmnt (nextLinep: cursorpp var nogood,emptyp,flushp: boolean
C00013 ENDMK
C⊗;
{$NOMAIN Editor: aux routines for addStmnt }
%include eedit.hdr;
{ Externally defined routines from elsewhere: }
(* From EAUX1A *)
procedure adjustDisplay; external;
(* From EAUX1C *)
procedure errPrnt; external;
(* From EPUT *)
procedure putLine; external;
(* From EAUX2C *)
procedure displayLines(var pfrom: integer); external;
procedure deleteLines(start,number,coff: integer); external;
procedure insertLines(start,number,coff: integer); external;
(* From ETOKEN *)
procedure getToken; external;
(* From EPUTST *)
procedure putstmnt(s: statementp; indent, plevel: integer); external;
(* From EPAR3B *)
function idGet(st: statementp; indent,l: integer): ascii; external;
(* From EPAR3D *)
function addNewDeclarations: integer; external;
(* From EAUX3C - addStmnt aux routines *)
procedure descend(st: statementp); external;
function elseTest(emptyp: boolean): boolean; external;
(* From PP *)
procedure relLine(l: linerecp); external;
procedure ppLine; external;
procedure ppOutNow; external;
procedure ppChar(ch: ascii); external;
procedure pp5(ch: c5str; length: integer); external;
procedure pp10(ch: cstring; length: integer); external;
procedure pp10L(ch: cstring; length: integer); external;
procedure pp20(ch: c20str; length: integer); external;
procedure pp20L(ch: c20str; length: integer); external;
procedure addEndStmnt (nextLinep: cursorpp; var nogood,emptyp,flushp: boolean;
var l,ocur: integer); external;
procedure addEndStmnt;
var i: integer;
begin
with curToken do
if nextLinep↑.stmntp and (nextLinep↑.st↑.stype = stmnt) then
begin (* move to previously defined stmnt *)
i := ord(idGet(nextLinep↑.st,0,0)); (* & get any block id *)
deleteLines(ocur,1,1); (* flush the extra line *)
if not fparse then
begin
l := cursorLine - topDline + 1; (* offset into line array *)
relLine(lines[l]); (* release old line *)
lines[l] := nil;
end
else if cursor = 3 then endOfLine := true;
end
else
begin
pp20L('Can''t have an END/CO',20); pp10('END here ',8); errPrnt;
nogood := true;
flushp := true;
end;
end;
procedure add2Aux (nextLinep: cursorpp; var l,ocur,lcur: integer;
var nogood,flushp: boolean; slabel: varidefp; labp: boolean); external;
procedure add2Aux;
begin
with curToken do
if endOfLine and (not fParse) and
nextLinep↑.stmntp and (nextLinep↑.st↑.stype = cmtype) then
begin
nextLinep↑.st↑.deferCm := true;
l := cursorLine - topDline + 2;
relLine(lines[l]); (* fix up lines array *)
lines[l] := nil;
firstLine := ocur;
lastLine := lcur;
curLine := 0;
putStmnt(dprog,0,99); (* re-display old line *)
putLine;
lines[l] := lines[l-1];
lines[l-1] := nil;
nogood := (slabel = nil) and not labp; (* flush line if no label *)
if nogood then ocur := ocur + 1;
end
else
begin
pp20L(' Expecting an ON her',20); ppChar('e'); errPrnt;
nogood := true;
flushp := true;
end
end;
procedure add4Aux (sp: statementp; var lcur,ocur: integer; slabel: varidefp;
nextLinep: cursorpp; nogood,stOk,clOk: boolean;
var emptyp,firstTime,flushp: boolean); external;
procedure add4Aux;
var j: integer; b: boolean;
begin
with curToken do
begin
if sp <> nil then
begin
if (sp↑.nlines > 1) and (lcur > 0) then
begin
insertLines(ocur+1,sp↑.nlines-1,1); (* make room for the extra lines *)
lcur := lcur + sp↑.nlines - 1;
end
end
else if slabel <> nil then
if nextLinep↑.stmntp then
with nextLinep↑.st↑ do
begin
stlab := slabel;
slabel↑.s := nextLinep↑.st;
nlines := nlines + 1;
end
else
begin pp20L(' Label has nothing t',20); pp10('o label ',7); errPrnt end;
if sParse then j := 0 else j := addNewDeclarations;
if nogood and (not emptyp) and (ocur = cursorLine) then
deleteLines(ocur,1,1)
else
begin
ocur := ocur + j;
lcur := lcur + j;
firstLine := ocur;
lastLine := lcur;
setCursor := true;
cursorLine := cursorLine + 1;
curLine := 0;
if not sParse then putStmnt(dprog,0,99) (* write & display new line *)
else
begin
cursor := sCursor - 1;
putStmnt(cursorStack[sCursor].st,0,99)
end;
if fParse then setCursor := false
else
begin
adjustDisplay; (* make sure cursor is on screen *)
displayLines(lineNum);
end;
end;
firstTime := false;
flushcomments := false; (* comments are ok here *)
if flushp then getToken;
while flushp and not endOfLine do (* in case of errors *)
begin (* leave things in a "clean" state *)
if ttype = reswdtype then
if (stOk and (rtype = stmnttype) and (stmnt <> assigntype)) or
(clOk and (rtype = filtype) and
(filler in [totype,viatype,withtype])) then
begin flushp := false; backup := true end
else getToken (* try next token *)
else if (ttype = delimtype) and (ch = ';') then flushp := false
else getToken; (* if still bad try next token *)
end;
if not sParse then (* skip semi's *)
begin
repeat getToken until (ttype <> delimtype) or (ch <> ';');
backup := true;
end
else if cursor < sCursor then
begin
cursor := sCursor;
emptyp := false;
b := not elseTest(emptyp); (* ELSE ok here? *)
if not b then
begin
cursor := sCursor;
descend(cursorStack[sCursor].st); (* how about a motion clause? *)
with cursorStack[cursor].st↑ do
b := (movetype <= stype) and (stype <= floattype);
end;
if b then
begin
getToken; (* check for ELSE or clause *)
backup := true;
endOfLine := (ttype = delimtype) and (ch = ';');
end
else endOfLine := true;
cursor := sCursor;
end;
end;
end;